home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / pa32v315.zip / TEST40.FRM < prev    next >
Text File  |  1997-01-12  |  8KB  |  317 lines
  1. VERSION 4.00
  2. Begin VB.Form TestForm 
  3.    Caption         =   "This is a test project for Project Analyzer"
  4.    ClientHeight    =   1080
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   5160
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   8.25
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    ForeColor       =   &H80000008&
  18.    Height          =   1485
  19.    Icon            =   "TEST40.frx":0000
  20.    Left            =   1035
  21.    LinkTopic       =   "Form1"
  22.    ScaleHeight     =   1080
  23.    ScaleWidth      =   5160
  24.    Top             =   1140
  25.    Width           =   5280
  26.    Begin VB.PictureBox Picture1 
  27.       Height          =   495
  28.       Left            =   3180
  29.       MouseIcon       =   "TEST40.frx":030A
  30.       MousePointer    =   99  'Custom
  31.       Picture         =   "TEST40.frx":074C
  32.       ScaleHeight     =   435
  33.       ScaleWidth      =   555
  34.       TabIndex        =   4
  35.       Top             =   60
  36.       Width           =   615
  37.    End
  38.    Begin VB.DriveListBox Drive1 
  39.       Height          =   315
  40.       Left            =   1140
  41.       MouseIcon       =   "TEST40.frx":14CE
  42.       MousePointer    =   99  'Custom
  43.       TabIndex        =   3
  44.       Top             =   660
  45.       Width           =   2475
  46.    End
  47.    Begin VB.ListBox List1 
  48.       Height          =   645
  49.       Index           =   0
  50.       ItemData        =   "TEST40.frx":1910
  51.       Left            =   60
  52.       List            =   "TEST40.frx":191D
  53.       MouseIcon       =   "TEST40.frx":1939
  54.       MousePointer    =   99  'Custom
  55.       TabIndex        =   2
  56.       Top             =   360
  57.       Width           =   915
  58.    End
  59.    Begin VB.CommandButton Quit 
  60.       Appearance      =   0  'Flat
  61.       BackColor       =   &H80000005&
  62.       Caption         =   "Quit"
  63.       Height          =   330
  64.       Left            =   3780
  65.       TabIndex        =   0
  66.       Top             =   630
  67.       Width           =   1275
  68.    End
  69.    Begin VB.Image Image2 
  70.       Appearance      =   0  'Flat
  71.       Height          =   240
  72.       Left            =   4320
  73.       Picture         =   "TEST40.frx":1A8B
  74.       Top             =   120
  75.       Width           =   240
  76.    End
  77.    Begin VB.Image Image1 
  78.       Appearance      =   0  'Flat
  79.       Height          =   240
  80.       Left            =   3960
  81.       Picture         =   "TEST40.frx":1B8D
  82.       Top             =   120
  83.       Width           =   240
  84.    End
  85.    Begin VB.Label Label1 
  86.       Appearance      =   0  'Flat
  87.       BackColor       =   &H80000005&
  88.       BackStyle       =   0  'Transparent
  89.       Caption         =   "This program will not do anything"
  90.       ForeColor       =   &H80000008&
  91.       Height          =   225
  92.       Left            =   210
  93.       TabIndex        =   1
  94.       Top             =   90
  95.       Width           =   3000
  96.    End
  97. End
  98. Attribute VB_Name = "TestForm"
  99. Attribute VB_Creatable = False
  100. Attribute VB_Exposed = False
  101. ' A test project for Project Analyzer
  102. ' (C)1996 MyCompany Ltd.
  103. ' This is the form of the main screen
  104. ' This file also includes some important database routines
  105.  
  106. DefStr W
  107.  
  108. Public DatabaseName$
  109. Dim Weekdays(0 To 6)
  110.  
  111. ' Project Analyzer doesn't understand MAX_BUTTONS isn't dead
  112. Const MAX_BUTTONS = 50
  113. Dim DynamicButton() As CommandButton
  114. Dim StaticButton(0 To MAX_BUTTONS) As CommandButton
  115.  
  116. Dim FName As String
  117. ' This is a module-level variable that overrides the
  118. ' global variable FName in Test40.bas
  119. Public FName2 As String
  120. ' This is a completely legal declaration in VB 4.0
  121. ' There is already a Public FName2 declared in Test40.bas
  122. ' This is another one
  123.  
  124.  
  125. ' Dim and Private mean the same here
  126. Dim TestObject As testclass
  127. Private AnotherTestObject As New testclass
  128.  
  129.  
  130.  
  131. Private Sub CloseDatabase(ByRef NumberArray() As Long, Optional ByRef DeadParam As Variant)
  132. ' Close the database
  133. ' Check that all information is up-to-date
  134.  
  135. ReDim Preserve DynamicButton(0 To MAX_BUTTONS / 2) As CommandButton
  136.  
  137. End Sub
  138.  
  139. Private Function ExtensionOnly(ByVal File As String) As String
  140. ' Returns file name extension "BAS"
  141. ' This is a module-level function that will override
  142. ' the global function ExtensionOnly defined in FILETEST.BAS
  143.  
  144. ExtensionOnly = Right(File, 3)
  145.  
  146. End Function
  147.  
  148. Private Function Fibonacci(ByVal n As Integer)
  149. ' Sample of a recursive call sequence
  150. ' This function is only called by SumFibonacci
  151. ' but not by any other procedure
  152. ' -> Fibonacci and SumFibonacci are dead code
  153.  
  154. If n = 1 Then
  155.     Fibonacci = 1
  156. ElseIf n = 2 Then
  157.     Fibonacci = 1
  158. Else
  159.     Fibonacci = SumFibonacci(n - 1, n - 2)
  160. End If
  161.  
  162. End Function
  163.  
  164. Private Sub Form_Load()
  165. ' Start of the program
  166.  
  167.  
  168. Set StaticButton(0) = quit
  169. Set TestObject = New testclass
  170. Dim TestObject2 As testclass
  171. testclass
  172.  
  173. Set TestObject2 = TestObject
  174.  
  175. ' This is a reference to Property Let Value in TestClass
  176. TestObject2.Value = 18
  177.  
  178. ' These are 1) a reference to Property Let Value
  179. ' and 2) a reference to Property Get Value in TestClass
  180. TestObject2.Value = TestObject2.Value + 1
  181.  
  182. ReadINIFile
  183. OpenDB
  184. RunTheProgram
  185.  
  186. End Sub
  187.  
  188. Private Sub Form_Unload(Cancel As Integer)
  189. ' Quit the program
  190. ' First close the database
  191.  
  192. Dim Array(1 To 2) As Long
  193. Set TestObject = Nothing
  194.  
  195. CloseDatabase Array
  196. End
  197.  
  198. End Sub
  199.  
  200. Private Sub OpenDB(ParamArray DeadArray() As Variant)
  201. ' Opening the DB
  202. ' Check for user rights
  203. ' Lock appropriate tables
  204.  
  205. ' Now we reference ExtensionOnly in this file
  206. If ExtensionOnly(FName) = "TXT" Then
  207.     '
  208. ' Then we reference ExtensionOnly in FileTest
  209. ElseIf FileModule.ExtensionOnly(FName) = "TXT" Then
  210. ElseIf IsDir("C:\WINDOWS") Then
  211.     If DriveType("C:", Drive1) <> DRIVE_FIXED Then
  212.         ' Panic
  213.     Else
  214.         ' Don't panic
  215.     End If
  216. End If
  217.  
  218. End Sub
  219.  
  220. Private Sub Image1_Click()
  221. ' This procedure tests the With statement
  222.  
  223. Const Value = 88
  224. With TestObject
  225.     ' Reference a property and a local const
  226.     .Value = .Value + Value
  227.     ' Call TestClass.ShowPublicHello
  228.     .showpublichello
  229.     ' Call TestForm.ShowPublicHello
  230.     showpublichello
  231. End With
  232.  
  233. ' Another with statement
  234. With Me
  235.     ' Call TestForm.ShowPublicHello again
  236.     .showpublichello
  237. End With
  238.  
  239.  
  240. End Sub
  241.  
  242.  
  243. Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  244.  
  245. If Button > 1 Then AnotherTestObject.showpublichello
  246.  
  247. End Sub
  248.  
  249.  
  250. Private Sub Quit_Click()
  251.  
  252. Unload Me
  253.  
  254. End Sub
  255.  
  256. Private Sub ReadINIFile()
  257. ' Read the configuration in PROJTEST.INI
  258. ' Note: If PROJTEST.INI doesn't exist, use defaults
  259.  
  260. Dim Test$
  261.  
  262. IsThere = IsFile("PROJTEST.INI")
  263.  
  264. End Sub
  265.  
  266. Private Sub RunTheProgram()
  267. ' Run the program only if there is at least 1 MB free
  268. ' disk space
  269. ' Otherwise show error message
  270.  
  271. If DiskSpaceFree("C:") < 1024 ^ 2 Then
  272. End If
  273.  
  274. End Sub
  275.  
  276. Private Function SumFibonacci(a, b)
  277. ' Sample of a recursive call sequence
  278. ' This function is only called by Fibonacci
  279. ' but not by any other procedure
  280. ' -> Fibonacci and SumFibonacci are dead code
  281.  
  282. SumFibonacci = Fibonacci(a) + Fibonacci(b)
  283.  
  284. End Function
  285.  
  286. Public Sub Blink()
  287. Attribute Blink.VB_Description = "This sub changes the background color\r\nof the form"
  288.  
  289. BackColor = &HFF00FF
  290.  
  291. End Sub
  292.  
  293.  
  294. Public Sub showpublichello()
  295. ' This sub is here to assure that Project Analyzer
  296. ' can make difference between
  297. ' TestClass.ShowPublicHello and TestForm.ShowPublicHello
  298.  
  299. MsgBox "Hellos from TestForm too!"
  300.  
  301. End Sub
  302.  
  303. Public Sub testclass()
  304. ' This is a sub that uses name shadowing extensively
  305.  
  306. Dim FName As Boolean
  307. Dim List1 As Integer
  308. Dim testclass As Integer
  309.  
  310. FName = True
  311. List1 = 3
  312. TestForm.List1(0).Clear
  313.  
  314. End Sub
  315.  
  316.  
  317.